home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / winfo.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  12.1 KB  |  362 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the "winfo" command.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) winfo.test 1.19 97/05/16 08:49:01
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     catch {destroy $i}
  18. }
  19. wm geometry . {}
  20. raise .
  21.  
  22. # eatColors --
  23. # Creates a toplevel window and allocates enough colors in it to
  24. # use up all the slots in the colormap.
  25. #
  26. # Arguments:
  27. # w -        Name of toplevel window to create.
  28. # options -    Options for w, such as "-colormap new".
  29.  
  30. proc eatColors {w {options ""}} {
  31.     catch {destroy $w}
  32.     eval toplevel $w $options
  33.     wm geom $w +0+0
  34.     canvas $w.c -width 400 -height 200 -bd 0
  35.     pack $w.c
  36.     for {set y 0} {$y < 8} {incr y} {
  37.     for {set x 0} {$x < 40} {incr x} {
  38.         set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  39.         $w.c create rectangle [expr 10*$x] [expr 20*$y] \
  40.             [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
  41.             -fill $color
  42.     }
  43.     }
  44.     update
  45. }
  46.  
  47. # XXX - This test file is woefully incomplete.  At present, only a
  48. # few of the winfo options are tested.
  49.  
  50. test winfo-1.1 {"winfo atom" command} {
  51.     list [catch {winfo atom} msg] $msg
  52. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  53. test winfo-1.2 {"winfo atom" command} {
  54.     list [catch {winfo atom a b} msg] $msg
  55. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  56. test winfo-1.3 {"winfo atom" command} {
  57.     list [catch {winfo atom a b c d} msg] $msg
  58. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  59. test winfo-1.4 {"winfo atom" command} {
  60.     list [catch {winfo atom -displayof geek foo} msg] $msg
  61. } {1 {bad window path name "geek"}}
  62. test winfo-1.5 {"winfo atom" command} {
  63.     winfo atom PRIMARY
  64. } 1
  65. test winfo-1.6 {"winfo atom" command} {
  66.     winfo atom -displayof . PRIMARY
  67. } 1
  68.  
  69. test winfo-2.1 {"winfo atomname" command} {
  70.     list [catch {winfo atomname} msg] $msg
  71. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  72. test winfo-2.2 {"winfo atomname" command} {
  73.     list [catch {winfo atomname a b} msg] $msg
  74. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  75. test winfo-2.3 {"winfo atomname" command} {
  76.     list [catch {winfo atomname a b c d} msg] $msg
  77. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  78. test winfo-2.4 {"winfo atomname" command} {
  79.     list [catch {winfo atomname -displayof geek foo} msg] $msg
  80. } {1 {bad window path name "geek"}}
  81. test winfo-2.5 {"winfo atomname" command} {
  82.     list [catch {winfo atomname 44215} msg] $msg
  83. } {1 {no atom exists with id "44215"}}
  84. test winfo-2.6 {"winfo atomname" command} {
  85.     winfo atomname 2
  86. } SECONDARY
  87. test winfo-2.7 {"winfo atom" command} {
  88.     winfo atomname -displayof . 2
  89. } SECONDARY
  90.  
  91. if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {
  92.     test winfo-3.1 {"winfo colormapfull" command} {
  93.     list [catch {winfo colormapfull} msg] $msg
  94.     } {1 {wrong # args: should be "winfo colormapfull window"}}
  95.     test winfo-3.2 {"winfo colormapfull" command} {
  96.     list [catch {winfo colormapfull a b} msg] $msg
  97.     } {1 {wrong # args: should be "winfo colormapfull window"}}
  98.     test winfo-3.3 {"winfo colormapfull" command} {
  99.     list [catch {winfo colormapfull foo} msg] $msg
  100.     } {1 {bad window path name "foo"}}
  101.     test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} {
  102.     eatColors .t {-colormap new}
  103.     set result [list [winfo colormapfull .] [winfo colormapfull .t]]
  104.     .t.c delete 34
  105.     lappend result [winfo colormapfull .t]
  106.     .t.c create rectangle 30 30 80 80 -fill #441739
  107.     lappend result [winfo colormapfull .t]
  108.     .t.c create rectangle 40 40 90 90 -fill #ffeedd
  109.     lappend result [winfo colormapfull .t]
  110.     destroy .t.c
  111.     lappend result [winfo colormapfull .t]
  112.     } {0 1 0 0 1 0}
  113.     catch {destroy .t}
  114. }
  115.  
  116. catch {destroy .t}
  117. toplevel .t -width 550 -height 400
  118. frame .t.f -width 80 -height 60 -bd 2 -relief raised
  119. place .t.f -x 50 -y 50
  120. wm geom .t +0+0
  121. update
  122. test winfo-4.1 {"winfo containing" command} {
  123.     list [catch {winfo containing 22} msg] $msg
  124. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  125. test winfo-4.2 {"winfo containing" command} {
  126.     list [catch {winfo containing a b c} msg] $msg
  127. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  128. test winfo-4.3 {"winfo containing" command} {
  129.     list [catch {winfo containing a b c d e} msg] $msg
  130. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  131. test winfo-4.4 {"winfo containing" command} {
  132.     list [catch {winfo containing -displayof geek 25 30} msg] $msg
  133. } {1 {bad window path name "geek"}}
  134. test winfo-4.5 {"winfo containing" command} {
  135.     winfo containing [winfo rootx .t.f] [winfo rooty .t.f]
  136. } .t.f
  137. test winfo-4.6 {"winfo containing" command} {nonPortable} {
  138.     winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1]
  139. } .t
  140. test winfo-4.7 {"winfo containing" command} {
  141.     set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \
  142.         [expr [winfo rooty .t.f]+450]]
  143.     expr {($x == ".") || ($x == "")}
  144. } {1}
  145. destroy .t
  146.  
  147. test winfo-5.1 {"winfo interps" command} {
  148.     list [catch {winfo interps a} msg] $msg
  149. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  150. test winfo-5.2 {"winfo interps" command} {
  151.     list [catch {winfo interps a b c} msg] $msg
  152. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  153. test winfo-5.3 {"winfo interps" command} {
  154.     list [catch {winfo interps -displayof geek} msg] $msg
  155. } {1 {bad window path name "geek"}}
  156. test winfo-5.4 {"winfo interps" command} {unixOnly} {
  157.     expr [lsearch -exact [winfo interps] [tk appname]] >= 0
  158. } {1}
  159. test winfo-5.5 {"winfo interps" command} {unixOnly} {
  160.     expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0
  161. } {1}
  162.  
  163. test winfo-6.1 {"winfo exists" command} {
  164.     list [catch {winfo exists} msg] $msg
  165. } {1 {wrong # args: should be "winfo exists window"}}
  166. test winfo-6.2 {"winfo exists" command} {
  167.     list [catch {winfo exists a b} msg] $msg
  168. } {1 {wrong # args: should be "winfo exists window"}}
  169. test winfo-6.3 {"winfo exists" command} {
  170.     winfo exists gorp
  171. } {0}
  172. test winfo-6.4 {"winfo exists" command} {
  173.     winfo exists .
  174. } {1}
  175. test winfo-6.5 {"winfo exists" command} {
  176.     button .b -text "Test button"
  177.     set x [winfo exists .b]
  178.     pack .b
  179.     update
  180.     bind .b <Destroy> {lappend x [winfo exists .x]}
  181.     destroy .b
  182.     lappend x [winfo exists .x]
  183. } {1 0 0}
  184.  
  185. catch {destroy .b}
  186. button .b -text "Help"
  187. update
  188. test winfo-7.1 {"winfo pathname" command} {
  189.     list [catch {winfo pathname} msg] $msg
  190. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  191. test winfo-7.2 {"winfo pathname" command} {
  192.     list [catch {winfo pathname a b} msg] $msg
  193. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  194. test winfo-7.3 {"winfo pathname" command} {
  195.     list [catch {winfo pathname a b c d} msg] $msg
  196. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  197. test winfo-7.4 {"winfo pathname" command} {
  198.     list [catch {winfo pathname -displayof geek 25} msg] $msg
  199. } {1 {bad window path name "geek"}}
  200. test winfo-7.5 {"winfo pathname" command} {
  201.     list [catch {winfo pathname xyz} msg] $msg
  202. } {1 {expected integer but got "xyz"}}
  203. test winfo-7.6 {"winfo pathname" command} {
  204.     list [catch {winfo pathname 224} msg] $msg
  205. } {1 {window id "224" doesn't exist in this application}}
  206. test winfo-7.7 {"winfo pathname" command} {
  207.     winfo pathname -displayof .b [winfo id .]
  208. } {.}
  209. test winfo-7.8 {"winfo pathname" command} {unixOnly} {
  210.     winfo pathname [testwrapper .]
  211. } {}
  212.  
  213. test winfo-8.1 {"winfo pointerx" command} {
  214.     catch [winfo pointerx .b]
  215. } 1
  216. test winfo-8.2 {"winfo pointery" command} {
  217.     catch [winfo pointery .b]
  218. } 1
  219. test winfo-8.3 {"winfo pointerxy" command} {
  220.     catch [winfo pointerxy .b]
  221. } 1
  222.  
  223. test winfo-9.1 {"winfo viewable" command} {
  224.     list [catch {winfo viewable} msg] $msg
  225. } {1 {wrong # args: should be "winfo viewable window"}}
  226. test winfo-9.2 {"winfo viewable" command} {
  227.     list [catch {winfo viewable foo} msg] $msg
  228. } {1 {bad window path name "foo"}}
  229. test winfo-9.3 {"winfo viewable" command} {
  230.     winfo viewable .
  231. } {1}
  232. test winfo-9.4 {"winfo viewable" command} {
  233.     wm iconify .
  234.     winfo viewable .
  235. } {0}
  236. wm deiconify .
  237. test winfo-9.5 {"winfo viewable" command} {
  238.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  239.     place .f1 -x 0 -y 0
  240.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  241.     place .f1.f2 -x 0 -y 0
  242.     update
  243.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  244. } {1 1}
  245. test winfo-9.6 {"winfo viewable" command} {
  246.     eval destroy [winfo child .]
  247.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  248.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  249.     place .f1.f2 -x 0 -y 0
  250.     update
  251.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  252. } {0 0}
  253. test winfo-9.7 {"winfo viewable" command} {
  254.     eval destroy [winfo child .]
  255.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  256.     place .f1 -x 0 -y 0
  257.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  258.     place .f1.f2 -x 0 -y 0
  259.     update
  260.     wm iconify .
  261.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  262. } {0 0}
  263. wm deiconify .
  264. eval destroy [winfo child .]
  265.  
  266. test winfo-10.1 {"winfo visualid" command} {
  267.     list [catch {winfo visualid} msg] $msg
  268. } {1 {wrong # args: should be "winfo visualid window"}}
  269. test winfo-10.2 {"winfo visualid" command} {
  270.     list [catch {winfo visualid gorp} msg] $msg
  271. } {1 {bad window path name "gorp"}}
  272. test winfo-10.3 {"winfo visualid" command} {
  273.     expr 2+[winfo visualid .]-[winfo visualid .]
  274. } {2}
  275.  
  276. test winfo-11.1 {"winfo visualid" command} {
  277.     list [catch {winfo visualsavailable} msg] $msg
  278. } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
  279. test winfo-11.2 {"winfo visualid" command} {
  280.     list [catch {winfo visualsavailable gorp} msg] $msg
  281. } {1 {bad window path name "gorp"}}
  282. test winfo-11.3 {"winfo visualid" command} {
  283.     list [catch {winfo visualsavailable . includeids foo} msg] $msg
  284. } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
  285. test winfo-11.4 {"winfo visualid" command} {
  286.     llength [lindex [winfo visualsa .] 0]
  287. } {2}
  288. test winfo-11.5 {"winfo visualid" command} {
  289.     llength [lindex [winfo visualsa . includeids] 0]
  290. } {3}
  291. test winfo-11.6 {"winfo visualid" command} {
  292.     set x [lindex [lindex [winfo visualsa . includeids] 0] 2]
  293.     expr $x + 2 - $x
  294. } {2}
  295.  
  296. test winfo-12.1 {GetDisplayOf procedure} {
  297.     list [catch {winfo atom - foo x} msg] $msg
  298. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  299. test winfo-12.2 {GetDisplayOf procedure} {
  300.     list [catch {winfo atom -d bad_window x} msg] $msg
  301. } {1 {bad window path name "bad_window"}}
  302.  
  303. # Some embedding tests
  304. # 
  305.  
  306. proc MakeEmbed {} {
  307.     frame .con -container 1
  308.     pack .con -expand yes -fill both
  309.     toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
  310.     button .emb.b
  311.     pack .emb.b -expand yes -fill both
  312.     update
  313. }
  314. test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
  315.     MakeEmbed
  316.     set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
  317.         [winfo rooty .emb] == [winfo rooty .con]]
  318.     destroy .emb
  319.     destroy .con
  320.     set z
  321. } {1}
  322. test winfo-13.2 {destroying embedded toplevel} {macOrUnix} {
  323.     catch {destroy .emb}
  324.     update
  325.     expr [winfo exists .emb.b] || [winfo exists .con]
  326. } 0
  327.  
  328. foreach i [winfo children .] {
  329.     destroy $i
  330. }
  331.  
  332. test winfo-13.3 {destroying container window} {macOrUnix} {
  333.     MakeEmbed
  334.     destroy .con
  335.     update
  336.     set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
  337.     catch {destroy .emb}
  338.     catch {destroy .con}
  339.     set z
  340. } 0
  341.  
  342. foreach i [winfo children .] {
  343.     destroy $i
  344. }
  345.  
  346. test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
  347.     MakeEmbed
  348.     button .b
  349.     pack .b -expand yes -fill both
  350.     update
  351.  
  352.     set z [string compare \
  353.     [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
  354.     catch {destroy .con}
  355.     catch {destroy .emb}
  356.     set z
  357. } 0
  358.  
  359. foreach i [winfo children .] {
  360.     catch {destroy $i}
  361. }
  362.